Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyNotifier.p

Text File | 1995-10-23 | 5.7 KB | 240 lines | [TEXT/CWIE]

unit MyNotifier;

{ Derived from <[e-mail]> Joe Holt's StartupError code as posted }
{ to comp.sys.mac.programmer in May 1991 }

{ Notification Manager messages }

{ History: }
{   jhh 18 jun 90 -- response to news posting }
{   pnl 29 may 91 -- Converted to pascal to be used in an application }

interface

    uses
        Types, Memory;

    const
        mark_app = 1;
        mark_none = 0;

    procedure StartupNotifier;
    procedure NotifyH (mark: integer; sound: handle; sicn: handle; str: stringPtr; display_time: longInt);
    procedure Notify (mark, sound: boolean; sicn_id, sicn_index, str_id, str_index: integer; display_time: longInt);
{ mark - mark the current application }
{ sound - play sysbeep }
{ sicn_id, sicn_index - SICN id to rotate with the apple & index (<1 -> 1)   OR 0&0 for no sicn }
{ str_id, str_index - STR# id & index    OR    STR id & 0    OR    0 & 0 }
    procedure UnNotify;
{ Call this to get rid of the notification }

    var
        notify_finished, notify_outstanding: boolean;
        time_to_unnotify: longInt;

implementation

    uses
        Types, Notification, GestaltEqu, Icons, OSUtils, TextUtils, Resources,
        MyStartup, MySystemGlobals;

    const
        sicn_size = 32;
        T_NMInstall = $A05E;
        T_Unimplemented = $A89F;

    type
        NMRecPtrPtr = ^NMRecPtr;
        booleanPtr = ^boolean;

    var
        current_note: NMRecPtr;

    var
        gMyResponseProc : UniversalProcPtr;

{ handles must be non-purgeable, but may be unlocked }

    procedure MyResponse (note: NMRecPtr);
    begin
        booleanPtr(note^.nmRefCon)^ := true;
    end;

    procedure UnNotify;
        var
            oe: OSErr;
    begin
        if current_note <> nil then begin
            oe := NMRemove(current_note);
            with current_note^ do begin
                if nmStr <> nil then begin
                    DisposePtr(pointer(nmStr));
                end;
                if nmIcon <> nil then begin
                    DisposeHandle(nmIcon);
                end;
            end;
            DisposePtr(pointer(current_note));
            current_note := nil;
        end;
        notify_finished := false;
        notify_outstanding := false;
        time_to_unnotify := maxLongInt;
    end;

    procedure NotifyH (mark: integer; sound: handle; sicn: handle; str: stringPtr; display_time: longInt);
        var
            error: boolean;
            oe: OSErr;
    begin
        UnNotify;            { Clear outstanding notify }
        if NGetTrapAddress(T_NMInstall, OSTrap) = NGetTrapAddress(T_Unimplemented, ToolTrap) then begin
            SysBeep(1);   { Best we can do I guess.  Could put up the dialog box maybe?...}
        end
        else begin
            current_note := NMRecPtr(NewPtr(sizeof(NMRec)));
            if current_note = nil then begin
                SysBeep(1);   { Can't do much else if there isnt even room for this! }
            end
            else begin
                with current_note^ do begin
                    qType := nmType;
                    error := false;
                    booleanPtr(nmRefCon) := @notify_finished;
                    nmMark := mark;
                    nmStr := str;
                    nmIcon := sicn;
                    nmSound := sound;
                    nmResp := gMyResponseProc;
                end;
                oe := NMInstall(current_note);
                if oe <> noErr then begin
                    current_note := nil;
                    SysBeep(1);
                end
                else begin
                    notify_outstanding := true;
                    if display_time > 0 then begin
                        time_to_unnotify := TickCount + display_time;
                    end;
                end;
            end;
        end;
    end;

    procedure Notify (mark, sound: boolean; sicn_id, sicn_index, str_id, str_index: integer; display_time: longInt);
        var
            errorText: str255;
            sh: stringHandle;
            sicnH: handle;
            error: boolean;
            nmMark: integer;
            nmStr: stringPtr;
            nmIcon: handle;
            nmSound: handle;
            gv: longInt;
    begin
        error := false;
        if mark then begin
            nmMark := 1;
        end else begin
            nmMark := 0;
        end;
        nmStr := nil;
        if str_id <> 0 then begin
            if str_index > 0 then begin
                GetIndString(errorText, str_id, str_index);
            end
            else begin
                errorText := '';
                sh := GetString(str_id);
                if sh <> nil then begin
                    if sh^ <> nil then begin
                        errorText := sh^^;
                    end;
                    ReleaseResource(handle(sh));
                end;
            end;
            if errorText = '' then begin
                error := true;
            end else begin
                nmStr := stringPtr(NewPtr(length(errorText) + 1));
                if nmStr = nil then begin
                    error := true;
                end else begin
                    nmStr^ := errorText;
                end;
            end;
        end;
        nmIcon := nil;
        if sicn_id <> 0 then begin

            nmIcon := nil;
            if (Gestalt(gestaltSystemVersion, gv) = noErr) & (gv >= $0700) then begin
                if GetIconSuite(nmIcon, sicn_id, svAllSmallData) <> noErr then begin
                    nmIcon := nil;
                end;
            end;
            if nmIcon = nil then begin
                if sicn_index < 1 then begin
                    sicn_index := 1;
                end;
                sicn_index := (sicn_index - 1) * sicn_size;   { 1-based, like STR# }
                sicnH := GetResource('SICN', sicn_id);
                HNoPurge(sicnH);
                if sicnH = nil then begin
                    error := true;
                end else begin
                    nmIcon := NewHandle(sicn_size);
                    if nmIcon = nil then begin
                        error := true;
                    end else if nmIcon^ = nil then begin
                        error := true;
                    end else if GetHandleSize(sicnH) < sicn_index + sicn_size then begin
                        error := true;
                    end else begin
                        BlockMoveData(ptr(longInt(sicnH^) + sicn_index), nmIcon^, sicn_size);
                    end;
                    ReleaseResource(sicnH);
                end;
            end;
        end;
        if sound or error then begin
            nmSound := handle(-1);
        end else begin
            nmSound := nil;
        end;
        NotifyH(nmMark, nmSound, nmIcon, nmStr, display_time);
    end;

    function InitNotifier(var msg: integer): OSStatus;
    begin
        msg := msg; { Unused }
        current_note := nil;
        notify_finished := false;
        notify_outstanding := false;
        time_to_unnotify := maxLongInt;
        gMyResponseProc := NewNMProc(@MyResponse);
        InitNotifier := noErr;
    end;

    procedure FinishNotifier;
    begin
        if current_note <> nil then begin
            UnNotify;
        end;
    end;

    procedure IdleNotifier;
    begin
        if (notify_finished and InForeground) or (TickCount > time_to_unnotify) then begin
            UnNotify;
        end;
    end;

    procedure StartupNotifier;
    begin
        SetStartup(InitNotifier, IdleNotifier, 10, FinishNotifier);
    end;

end.